Theme Song
FRA : Elle me dit
CHN : 她对我说
ENG : She told me
JPN : 彼女は私に言う
FRA : écris une chanson contente
CHN : 写一首欢快的歌
ENG : Write a happy song
JPN : 幸せな歌を書く
FRA : Pas une chanson déprimante
CHN : 而不是悲伤的歌
ENG : Not a depressing song
JPN : 気のめいるような歌ではない
FRA : Une chanson que tout le monde aime
CHN : 一首让所有人都喜欢的歌
ENG : A song that everyone loves
JPN : みんなが大好きな曲
FRA : Elle me dit
CHN : 她对我说
ENG : She told me
JPN : 彼女は私に言う
FRA : Tu deviendras milliardaire
CHN : 你将成为亿万富翁
ENG : You will become a millionaire
JPN : あなたは億万長者になります
FRA : Tu auras de quoi être fier
CHN : 你将为此感到骄傲
ENG : You will be proud
JPN : あなたは誇りに思うでしょう
# install.packages("remotes")
library('BBmisc', 'rmsfuns')
#remotes::install_github("rstudio/sass")
lib('sass')
## sass
## TRUE
/* https://stackoverflow.com/a/66029010/3806250 */
h1 { color: #002C54; }
h2 { color: #2F496E; }
h3 { color: #375E97; }
h4 { color: #556DAC; }
h5 { color: #92AAC7; }
/* ----------------------------------------------------------------- */
/* https://gist.github.com/himynameisdave/c7a7ed14500d29e58149#file-broken-gradient-animation-less */
.hover01 {
/* color: #FFD64D; */
background: linear-gradient(155deg, #EDAE01 0%, #FFEB94 100%);
transition: all 0.45s;
&:hover{
background: linear-gradient(155deg, #EDAE01 20%, #FFEB94 80%);
}
}
.hover02 {
color: #FFD64D;
background: linear-gradient(155deg, #002C54 0%, #4CB5F5 100%);
transition: all 0.45s;
&:hover{
background: linear-gradient(155deg, #002C54 20%, #4CB5F5 80%);
}
}
.hover03 {
color: #FFD64D;
background: linear-gradient(155deg, #A10115 0%, #FF3C5C 100%);
transition: all 0.45s;
&:hover{
background: linear-gradient(155deg, #A10115 20%, #FF3C5C 80%);
}
}
## https://stackoverflow.com/a/36846793/3806250
options(width = 999)
knitr::opts_chunk$set(class.source = 'hover01', class.output = 'hover02', class.error = 'hover03')
if(!suppressPackageStartupMessages(require('BBmisc'))) {
install.packages('BBmisc', dependencies = TRUE, INSTALL_opts = '--no-lock')
}
suppressPackageStartupMessages(require('BBmisc'))
# suppressPackageStartupMessages(require('rmsfuns'))
## load packages
pkgs <- c('knitr', 'kableExtra', 'tint', 'dygraphs',
'devtools','readr', 'lubridate', 'data.table', 'reprex',
'feather', 'purrr', 'quantmod', 'tidyquant', 'plotly',
'furrr', 'flyingfox', 'tidyr', 'jsonlite', 'MASS',
'timetk', 'plyr', 'dplyr', 'stringr', 'magrittr',
'tdplyr', 'tidyverse', 'memoise', 'htmltools',
'formattable', 'rbokeh', 'dash', 'dashCoreComponents',
'dashHtmlComponents', 'dtplyr', 'viridis', 'hrbrthemes',
##https://dashr.plotly.com
'zoo', 'forecast', 'seasonal', 'seasonalview', 'rjson',
'rugarch', 'rmgarch', 'mfGARCH', 'sparklyr', 'jcolors',
'microbenchmark', 'dendextend', 'lhmetools', 'ggthemr',
'stringr', 'pacman', 'profmem', 'ggthemes', 'paletteer',
'htmltools', 'echarts4r', 'tsibble', 'fable',
'fabletools', 'tsibbledata', 'tibbletime', 'feasts',
'fpp3', 'prophet', 'fasster', 'fpp3', 'MASS',
'fable.prophet')
# remotes::install_github("robjhyndman/fpp3-package")
# https://tidyverts.github.io/tidy-forecasting-principles/tsibble.html
# https://facebook.github.io/prophet/docs/quick_start.html
# https://github.com/mpiktas/midasr
# https://github.com/onnokleen/mfGARCH
# devtools::install_github("business-science/tibbletime")
# devtools::install_github("DavisVaughan/furrr")
suppressAll(lib(pkgs))
# load_pkg(pkgs)
## Set the timezone but not change the datetime
Sys.setenv(TZ = 'Asia/Tokyo')
## options(knitr.table.format = 'html') will set all kableExtra tables to be 'html', otherwise need to set the parameter on every single table.
options(warn = -1, knitr.table.format = 'html')#, digits.secs = 6)
suppressAll(lib(pkgs))
# load_pkg(pkgs)
## Set the timezone but not change the datetime
Sys.setenv(TZ = 'Asia/Tokyo')
## options(knitr.table.format = 'html') will set all kableExtra tables to be 'html', otherwise need to set the parameter on every single table.
options(warn = -1, knitr.table.format = 'html')#, digits.secs = 6)
## https://stackoverflow.com/questions/39417003/long-vectors-not-supported-yet-abnor-in-rmd-but-not-in-r-script
knitr::opts_chunk$set(message = FALSE, warning = FALSE)#,
#cache = TRUE, cache.lazy = FALSE)
## https://www.researchgate.net/post/How_to_solve_abnor_cannot_allocate_vector_of_size_12_Gb_in_R
#memory.size() ### Checking your memory size
#memory.limit() ## Checking the set limit
#memory.size(size=500000)
#memory.limit(size=56000) ### expanding your memory _ here it goes beyond to your actually memory. This 56000 is proposed for 64Bit.
rm(pkgs)
## read files if not exists
if(!exists('dsmp')) {
if(str_detect(Sys.info()[1], 'Linux')) {
## check if data path set
if(!exists('.dtr')) {
.dtr <- '/home/englianhu/Documents/GitHub/binary.com-interview-question-data/'}
dsmp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/dsmp.rds'))
## save files if not exists
if(!file.exists(paste0(.dtr, 'data/fx/USDJPY/dsmp.rds'))) {
saveRDS(dsmp, paste0(.dtr, 'data/fx/USDJPY/dsmp.rds'))}
}
if(str_detect(Sys.info()[1], 'Windows')) {
## check if data path set
if(!exists('.dtr')) {
.dtr <- 'C:/Users/User/Documents/GitHub/binary.com-interview-question-data/'}
dsmp <- readRDS(paste0(.dtr, 'data/fx/USDJPY/dsmp.rds'))
## save files if not exists
if(!file.exists(paste0(.dtr, 'data/fx/USDJPY/dsmp.rds'))) {
saveRDS(dsmp, paste0(.dtr, 'data/fx/USDJPY/dsmp.rds'))}
}
}
dsmp <- dsmp |>
## as_tsibble() when needed since we can set number of keys
#as_tsibble(key = c(close, quarter, month, week, wkdays), index = index) |>
arrange(index)
## plot sample data
rbind(head(dsmp, 3), tail(dsmp, 3)) %>%
kbl(caption = '1 min Close Price Dataset', escape = FALSE) %>%
row_spec(0, background = 'DimGrey', color = 'gold', bold = TRUE) |>
column_spec(1, background = 'CornflowerBlue') |>
column_spec(2, background = 'Gray') |>
column_spec(3, background = 'DarkGrey') |>
column_spec(4, background = 'Gray') |>
column_spec(5, background = 'DarkGrey') |>
column_spec(6, background = '#4897D8') |>
column_spec(7, background = '#556DAC') |>
column_spec(8, background = '#92AAC7') |>
column_spec(9, background = '#556DAC') |>
column_spec(10, background = '#375E97') |>
column_spec(11, background = 'CornflowerBlue') |>
column_spec(12, background = 'LightGray', color = 'goldenrod') |>
kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) |>
kable_material(full_width = FALSE) %>% ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
scroll_box(width = '100%', fixed_thead = TRUE, height = '400px')
| index | year | quarter | month | week | wkdays | wk_1m | dy_1m | hr_1m | sq | date | close |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 2015-01-05 00:01:00 | 2015 | 1 | 1 | 1 | Monday | 1 | 1 | 1 | 1 | 2015-01-05 | 120.5740 |
| 2015-01-05 00:02:00 | 2015 | 1 | 1 | 1 | Monday | 2 | 2 | 2 | 2 | 2015-01-05 | 120.5900 |
| 2015-01-05 00:03:00 | 2015 | 1 | 1 | 1 | Monday | 3 | 3 | 3 | 3 | 2015-01-05 | 120.6035 |
| 2018-07-06 23:58:00 | 2018 | 3 | 7 | 27 | Friday | 7198 | 1438 | 58 | 1324798 | 2018-07-06 | 110.4740 |
| 2018-07-06 23:59:00 | 2018 | 3 | 7 | 27 | Friday | 7199 | 1439 | 59 | 1324799 | 2018-07-06 | 110.4740 |
| 2018-07-07 00:00:00 | 2018 | 3 | 7 | 27 | Saturday | 7200 | 1440 | 60 | 1324800 | 2018-07-07 | 110.4740 |
source : 1324800 x 12
## plot sample data
dp_df <- dsmp[dsmp$index %in% dsmp$index[duplicated(dsmp$index)],]
rbind(head(dp_df, 3), tail(dp_df, 3)) %>%
kbl(caption = 'NA and Duplicated Dataset', escape = FALSE) %>%
row_spec(0, background = 'DimGrey', color = 'gold', bold = TRUE) |>
column_spec(1, background = 'CornflowerBlue') |>
column_spec(2, background = 'Gray') |>
column_spec(3, background = 'DarkGrey') |>
column_spec(4, background = 'Gray') |>
column_spec(5, background = 'DarkGrey') |>
column_spec(6, background = '#4897D8') |>
column_spec(7, background = '#556DAC') |>
column_spec(8, background = '#92AAC7') |>
column_spec(9, background = '#556DAC') |>
column_spec(10, background = '#375E97') |>
column_spec(11, background = 'CornflowerBlue') |>
column_spec(12, background = 'LightGray', color = 'goldenrod') |>
kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) |>
kable_material(full_width = FALSE) %>% ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
scroll_box(width = '100%', fixed_thead = TRUE, height = '400px')
| index | year | quarter | month | week | wkdays | wk_1m | dy_1m | hr_1m | sq | date | close |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 2018-01-02 00:01:00 | 2018 | 1 | 1 | 1 | Tuesday | 2 | 2 | 2 | 1123202 | 2018-01-02 | 112.6295 |
| 2018-01-02 00:01:00 | 2017 | 1 | 1 | 53 | Tuesday | 1 | 1 | 1 | 1123201 | 2018-01-02 | NA |
| 2018-01-02 00:02:00 | 2018 | 1 | 1 | 1 | Tuesday | 4 | 4 | 4 | 1123204 | 2018-01-02 | 112.6295 |
| 2018-01-06 23:59:00 | 2017 | 1 | 1 | 53 | Saturday | 7197 | 1437 | 57 | 1137597 | 2018-01-06 | NA |
| 2018-01-07 00:00:00 | 2018 | 1 | 1 | 1 | Sunday | 7200 | 1440 | 60 | 1137600 | 2018-01-07 | 113.0580 |
| 2018-01-07 00:00:00 | 2017 | 1 | 1 | 53 | Sunday | 7199 | 1439 | 59 | 1137599 | 2018-01-07 | NA |
source : 14400 x 12
from above table, we know there have same index and NA value, here we need to rearrange the durations an sq columns elements.
ddsmp <- na.omit(dsmp) |>
{\(df) df |>
dplyr::mutate(
sq = 1:n(),
date = as_date(index),
quarter = quarter(index),
month = month(index),
wkdays = weekdays(index),
wk_1m = rep(1:7200, nrow(df)/7200),
dy_1m = rep(1:1440, nrow(df)/1440),
hr_1m = rep(1:60, nrow(df)/60)) |>
dplyr::select(index, year, quarter, month,
week, wkdays, wk_1m, dy_1m, hr_1m,
sq, date, close)}()
## save files if not exists
if(!file.exists(paste0(.dtr, 'data/fx/USDJPY/ddsmp.rds'))) {
saveRDS(ddsmp, paste0(.dtr, 'data/fx/USDJPY/ddsmp.rds'))}
source : 1317600 x 12
## plot sample data
rbind(head(ddsmp, 3), tail(ddsmp, 3)) %>%
kbl(caption = '1 min Close Price Dataset', escape = FALSE) %>%
row_spec(0, background = 'DimGrey', color = 'gold', bold = TRUE) |>
column_spec(1, background = 'CornflowerBlue') |>
column_spec(2, background = 'Gray') |>
column_spec(3, background = 'DarkGrey') |>
column_spec(4, background = 'Gray') |>
column_spec(5, background = 'DarkGrey') |>
column_spec(6, background = '#4897D8') |>
column_spec(7, background = '#556DAC') |>
column_spec(8, background = '#92AAC7') |>
column_spec(9, background = '#556DAC') |>
column_spec(10, background = '#375E97') |>
column_spec(11, background = 'CornflowerBlue') |>
column_spec(12, background = 'LightGray', color = 'goldenrod') |>
kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) |>
kable_material(full_width = FALSE) |> ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
scroll_box(width = '100%', fixed_thead = TRUE, height = '400px')
| index | year | quarter | month | week | wkdays | wk_1m | dy_1m | hr_1m | sq | date | close |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 2015-01-05 00:01:00 | 2015 | 1 | 1 | 1 | Monday | 1 | 1 | 1 | 1 | 2015-01-05 | 120.5740 |
| 2015-01-05 00:02:00 | 2015 | 1 | 1 | 1 | Monday | 2 | 2 | 2 | 2 | 2015-01-05 | 120.5900 |
| 2015-01-05 00:03:00 | 2015 | 1 | 1 | 1 | Monday | 3 | 3 | 3 | 3 | 2015-01-05 | 120.6035 |
| 2018-07-06 23:58:00 | 2018 | 3 | 7 | 27 | Friday | 7198 | 1438 | 58 | 1317598 | 2018-07-06 | 110.4740 |
| 2018-07-06 23:59:00 | 2018 | 3 | 7 | 27 | Friday | 7199 | 1439 | 59 | 1317599 | 2018-07-06 | 110.4740 |
| 2018-07-07 00:00:00 | 2018 | 3 | 7 | 27 | Saturday | 7200 | 1440 | 60 | 1317600 | 2018-07-07 | 110.4740 |
source : 1317600 x 12
## convert to time series tsibble
ts1_ddsmp <- as_tsibble(ddsmp, index = index)
ts2_ddsmp <- ddsmp |>
as_tsibble(key = c(close, quarter, month, week, wkdays), index = index)
timeID <- unique(ddsmp$date)
bse <- ddsmp[ddsmp$year == 2016,]$date[1] #"2016-01-04" #1st trading date in 2nd year
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
vrb <- 1200 #1200 observations
frb <- 1
i <- 1
train1A <- ts1_ddsmp |>
{\(.) filter(., date < timeID[i]) |>
tail(vrb)}()
fit1A <- train1A |>
model(
ets = ETS(close ~ error('M') + trend('N') + season('N')),
ets_bc = ETS(box_cox(close, 0.3) ~ error('A') + trend('N') + season('N')),
arima = ARIMA(close),
rw = RW(close),
rw_df = RW(close ~ drift()),
naive = NAIVE(close),
snaive = SNAIVE(close))
fc1A <- fit1A |>
{\(.) forecast(.$close, h = frb)}()
## Error in NROW(new_data): argument "new_data" is missing, with no default
fc1A |>
accuracy(ts1_ddsmp)
## Error in accuracy(fc1A, ts1_ddsmp): object 'fc1A' not found
train1B <- ddsmp |>
{\(.) filter(., date < timeID[i]) |>
tail(vrb) |>
as_tsibble(key = c(close, quarter, month, week, wkdays), index = index)}()
fit1B <- train1B |>
model(
ets = ETS(close ~ error('M') + trend('N') + season('N')),
ets_bc = ETS(box_cox(close, 0.3) ~ error('A') + trend('N') + season('N')),
arima = ARIMA(close),
rw = RW(close),
rw_df = RW(close ~ drift()),
naive = NAIVE(close),
snaive = SNAIVE(close))
## Error: Input must be a vector, not a function.
fc1B <- fit1B |>
{\(.) forecast(.$close, h = frb)}()
## Error in forecast(.$close, h = frb): object 'fit1B' not found
fc1B |>
accuracy(ts1_ddsmp)
## Error in accuracy(fc1B, ts1_ddsmp): object 'fc1B' not found
train1C <- ts2_ddsmp |>
{\(.) filter(., date < timeID[i]) |>
tail(vrb)}()
fit1C <- train1C |>
model(
ets = ETS(close ~ error('M') + trend('N') + season('N')),
ets_bc = ETS(box_cox(close, 0.3) ~ error('A') + trend('N') + season('N')),
arima = ARIMA(close),
rw = RW(close),
rw_df = RW(close ~ drift()),
naive = NAIVE(close),
snaive = SNAIVE(close))
## Error: Input must be a vector, not a function.
fc1C <- fit1C |>
{\(.) forecast(.$close, h = frb)}()
## Error in forecast(.$close, h = frb): object 'fit1C' not found
fc1C |>
accuracy(ts2_ddsmp)
## Error in accuracy(fc1C, ts2_ddsmp): object 'fc1C' not found
train1D <- ts2_ddsmp |>
{\(.) filter(., date < timeID[i]) |>
tail(vrb) |>
as_tsibble(key = c(close, quarter, month, week, wkdays), index = index)}()
fit1D <- train1D |>
model(
ets = ETS(close ~ error('M') + trend('N') + season('N')),
ets_bc = ETS(box_cox(close, 0.3) ~ error('A') + trend('N') + season('N')),
arima = ARIMA(close),
rw = RW(close),
rw_df = RW(close ~ drift()),
naive = NAIVE(close),
snaive = SNAIVE(close))
## Error: Input must be a vector, not a function.
fc1D <- fit1D |>
{\(.) forecast(.$close, h = frb)}()
## Error in forecast(.$close, h = frb): object 'fit1D' not found
fc1D |>
accuracy(ts2_ddsmp)
## Error in accuracy(fc1D, ts2_ddsmp): object 'fc1D' not found
## filter data by date
timeID <- unique(dsmp$date)
bse <- dsmp[year == 2016]$date[1] #"2016-01-04" #1st trading date in 2nd year
## Error in year == 2016: comparison (1) is possible only for atomic and list types
timeID %<>% .[. >= bse]
#timeID %<>% .[. >= as_date('2016-01-04')]
vrb <- 7200 #last 7200 observations DT[(.N - (vrb - 1)):.N]
frb <- 1440
i = 1
train <- dsmp[date < timeID[i]][(.N - (vrb - 1)):.N]
## Error in `<.default`(date, timeID[i]): comparison (3) is possible only for atomic and list types
ctr <- (train[,(sq)][1]):(train[.N,(sq)] + frb)
## Error in eval(expr, envir, enclos): object 'train' not found
## convert to tsibble data
train %<>%
as_tsibble(key = close, index = index)
## Error in as_tsibble(., key = close, index = index): object 'train' not found
train_test <- dsmp[sq %in% ctr] |>
as_tsibble(key = close, index = index)
## Error in sq %in% ctr: object 'sq' not found
## modeling
fit <- train |>
model(
ets = ETS(close),
#ets_bc = ETS(box_cox(close, 0.3)),
arima = ARIMA(close),
rw = RW(close),
rw_df = RW(close ~ drift()),
naive = NAIVE(close),
snaive = SNAIVE(close)
)
## Error in model(train, ets = ETS(close), arima = ARIMA(close), rw = RW(close), : object 'train' not found
## forecast
fc <- fit |>
forecast(h = frb)
## Error in forecast(fit, h = frb): object 'fit' not found
## accuracy
fc |> fabletools::accuracy(train_test)
## Error in fabletools::accuracy(fc, train_test): object 'fc' not found
timetk::tk_ts()Chapter 12 Advanced forecasting methods in Forecasting: Principles and Practice (3rd Edt)
my_dcmp_spec <- decomposition_model(
STL(close ~ season(period = 1440), robust = TRUE),
ETS(season_adjust ~ season('N')))
fit <- smp1 |>
as_tsibble(index = index) |>
model(
ets = ETS(close ~ trend('A')),
ets_bc = ETS(box_cox(close, 0.3)), #https://stackoverflow.com/questions/26617587/finding-optimal-lambda-for-box-cox-transform-in-r
#ets_lg = ETS(my_scaled_logit(mdeaths, 750, 3000) ~ error('A') + trend('N') + season('A')), #http://fable.tidyverts.org/articles/transformations.html
arima = ARIMA(close),
rw = RW(close),
rw_df = RW(close ~ drift()),
naive = NAIVE(close),
snaive = SNAIVE(close),
snaive_ = SNAIVE(close ~ lag('year'))#,
#dcmp = my_dcmp_spec
)
## Error in as_tsibble(smp1, index = index): object 'smp1' not found
fit |>
forecast(h = 1440) |>
autoplot()
## Error in forecast(fit, h = 1440): object 'fit' not found
#dsmp |> as_tsibble(key = c(qrt, mon, wek, wkdays, sq_1m), index = index)
suppressMessages(require('dplyr', quietly = TRUE))
suppressMessages(require('magrittr', quietly = TRUE))
suppressMessages(require('formattable', quietly = TRUE))
suppressMessages(require('knitr', quietly = TRUE))
suppressMessages(require('kableExtra', quietly = TRUE))
sys1 <- devtools::session_info()$platform %>%
unlist() %>%
(function(df) data.frame(Category = names(df), session_info = df))()
rownames(sys1) <- NULL
sys2 <- data.frame(Sys.info()) |>
(function(df) df |>
dplyr::mutate(Category = rownames(df)) |>
dplyr::select(2,1) |>
dplyr::rename('Sys.info' = 'Sys.info..'))()
rownames(sys2) <- NULL
if (nrow(sys1) == 9 & nrow(sys2) == 8) {
sys2 %<>% rbind(., data.frame(
Category = 'Current time',
Sys.info = paste(as.character(lubridate::now('Asia/Tokyo')), 'JST🗾')))
} else {
sys1 %<>% rbind(., data.frame(
Category = 'Current time',
session_info = paste(as.character(lubridate::now('Asia/Tokyo')), 'JST🗾')))
}
sys <- cbind(sys1, sys2) |>
kbl(caption = 'Additional session information:') |>
kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) |>
row_spec(0, background = 'DimGrey', color = 'yellow') |>
column_spec(1, background = 'CornflowerBlue', color = 'red') |>
column_spec(2, background = 'grey', color = 'black') |>
column_spec(3, background = 'CornflowerBlue', color = 'blue') |>
column_spec(4, background = 'grey', color = 'white') |>
row_spec(9, bold = T, color = 'yellow', background = '#D7261E')
rm(sys1, sys2)
sys
| Category | session_info | Category | Sys.info |
|---|---|---|---|
| version | R version 4.1.0 (2021-05-18) | sysname | Linux |
| os | Ubuntu 20.04.2 LTS | release | 5.8.0-55-generic |
| system | x86_64, linux-gnu | version | #62~20.04.1-Ubuntu SMP Wed Jun 2 08:55:04 UTC 2021 |
| ui | X11 | nodename | Scibrokes-Trading |
| language | en | machine | x86_64 |
| collate | en_US.UTF-8 | login | englianhu |
| ctype | en_US.UTF-8 | user | englianhu |
| tz | Asia/Tokyo | effective_user | englianhu |
| date | 2021-06-07 | Current time | 2021-06-07 03:00:13 JST🗾 |